Attribute VB_Name = "modCustomLabelsMitel"
 '---------------------------------------------------------------------------------------
'Module : modCustomLabels
'Date   : 07/12/2004
'Author : Chris Elwell
'Purpose: CreatCustomLabel is called from the main code. See description for details.
'         Add any other code here that is necessary when producing custom labels.
'---------------------------------------------------------------------------------------
'

' See Project properties for Conditional Compilation
#If Mitel Then

'---------------------------------------------------------------------------------------
' Module    : CreateTotalLabel
' DateTime  : 12/29/2005
' Author    : Nancy Lesser
' Purpose   : Print totals label - 1st tracking number(master), net charges, ref, pkg count

'-----------------------------------------------
 'This is a break down of the eltron label buffer
 '-----------------------------------------------
'Format second label
'create the barcode string
'A050, 050, 0,3,2,2,N,"DATA"  (broken down)
'A - Printing Text
'050 - starting horizontal position
'050 starting vertical position
'0 - rotation (no rotation)
'3 - font size (10 point)
'2 - horizontal multiplier, expand text horizontally (X2)
'2 - vertical multiplier, expand text vetically (X2)
'N - normal image
'"DATA" - a fixed data field (must be in double quotes)
'The CIC helpdesk can email a copy of the Eltron Advanced
'Programming Guide in .pdf format for more detailed information.
Public Sub CreateTotalLabel()
     
     On Error GoTo CreateTotalLabelEH:
 
    Dim strService As String
    Dim strCharges As String
    Dim strAddressLbl As String
    Dim lngTotalCharge As Double
    Dim strLTLProNum As String
    Dim strLTLPackNum As String
    Dim strLTLWeight As String
    
    If g_str116 = "1" Then
        g_strRef = g_str25
        g_strTotalWeight = Val(g_str1670)
        g_intTotMPSWgt = Val(g_str1670)
    Else
        g_strTotalWeight = CStr(g_lngTotalWeight)
    End If
    
    lngTotalCharge = Val(g_str37)
'
'    If Val(g_str1274) = "6" Then
'        lngTotalCharge = lngTotalCharge * 16
'    End If
'
'    If Val(g_str1274) <> "6" Then
'        lngTotalCharge = lngTotalCharge * 16
'    End If
    
    ' Add 40% to net charges to show on total label
    'lngTotalCharge = lngTotalCharge * 1.4
        If Val(g_str1274) <> "111" Then
            strCharges = CStr(lngTotalCharge)
            If strCharges <> "0" Then
                'strCharges = "$" & Left(strCharges, (Len(strCharges) - 2)) & "." & Right(strCharges, 2)
                strCharges = Left(strCharges, (Len(strCharges) - 2)) & "." & Right(strCharges, 2)
                strCharges = "$" & CCur(CDbl(strCharges) * 1.6)
            End If
            
        End If
    strService = Val(g_str1274)
    
    Select Case strService
        Case Is = "1"
            strService = "Priority Overnight"
            If g_str50 <> "US" Then
                strService = "International Priority"
            End If
        Case Is = "5"
            strService = "Standard Overnight"
        Case Is = "3"
            strService = "2 Day"
            If g_str50 <> "US" Then
                strService = "International Economy"
            End If
        Case Is = "6"
            strService = "First Overnight"
        Case Is = "20"
            strService = "Express Saver"
        Case Is = "90"
            strService = "Ground Home Delivery"
        Case Is = "92"
            strService = "Ground"
        Case Is = "111"
            strService = "FedEx Freight (LTL)"
        Case Is = "70"
            strService = "1 Day Express Freight"
        Case Is = "80"
            strService = "2 Day Express Freight"
        Case Is = "83"
            strService = "3 Day Express Freight"
        Case Else
            strService = "Service Unknown"
    End Select
    
    strAddressLbl = "N" & vbCrLf    'clears buffer image to print on second
    
    strAddressLbl = strAddressLbl & "ZA" & vbCrLf   'print direction -prints upside down
    
    If strService <> "FedEx Freight (LTL)" Then
        strAddressLbl = strAddressLbl & "A300,1200,0,3,1,1,N,""Reference: """
        strAddressLbl = strAddressLbl & Chr(34) & g_strRef & Chr(34) & vbCrLf
    Else
        strAddressLbl = strAddressLbl & "A300,1200,0,3,1,1,N,""Reference: """
        strAddressLbl = strAddressLbl & Chr(34) & g_strRef & Chr(34) & vbCrLf
    End If
    
    strAddressLbl = strAddressLbl & "A20,1225,0,3,1,1,N,""Date: """
    strAddressLbl = strAddressLbl & Chr(34) & Date & Chr(34) & vbCrLf
    
    If strService <> "FedEx Freight (LTL)" Then
        strAddressLbl = strAddressLbl & "A300,1225,0,3,1,1,N,""TrackingNumber: """
        strAddressLbl = strAddressLbl & Chr(34) & g_str29 & Chr(34) & vbCrLf
    Else
        strAddressLbl = strAddressLbl & "A300,1225,0,3,1,1,N,""ProNumber: """
        strAddressLbl = strAddressLbl & Chr(34) & g_strLTLProNum & Chr(34) & vbCrLf
    End If
    
    If strService <> "FedEx Freight (LTL)" Then
        strAddressLbl = strAddressLbl & "A300,1250,0,3,1,1,N,""Package Count: """
        strAddressLbl = strAddressLbl & Chr(34) & g_str116 & Chr(34) & vbCrLf
    Else
        strAddressLbl = strAddressLbl & "A300,1250,0,3,1,1,N,""Package Count: """
        strAddressLbl = strAddressLbl & Chr(34) & g_strFreightCount & Chr(34) & vbCrLf
    End If
        
    If strService <> "FedEx Freight (LTL)" Then
        strAddressLbl = strAddressLbl & "A300,1275,0,3,1,1,N,""Net Charges: """
        strAddressLbl = strAddressLbl & Chr(34) & strCharges & Chr(34) & vbCrLf
    Else
        strAddressLbl = strAddressLbl & "A300,1275,0,3,1,1,N,""Net Charges: """
        strAddressLbl = strAddressLbl & Chr(34) & strCharges & Chr(34) & vbCrLf
    End If
         
    
    If strService <> "FedEx Freight (LTL)" Then
        strAddressLbl = strAddressLbl & "A300,1300,0,3,1,1,N,""Total Weight: """
        strAddressLbl = strAddressLbl & Chr(34) & CStr(g_intTotMPSWgt) & Chr(34) & vbCrLf
    Else
        strAddressLbl = strAddressLbl & "A300,1300,0,3,1,1,N,""Total Weight: """
        strAddressLbl = strAddressLbl & Chr(34) & g_strFreightWeight & Chr(34) & vbCrLf
    End If
    
    
    strAddressLbl = strAddressLbl & "A300,1325,0,3,1,1,N,""Service: """
    strAddressLbl = strAddressLbl & Chr(34) & strService & Chr(34) & vbCrLf
    
    strAddressLbl = strAddressLbl & "P1" & vbCrLf   'print 1 copy
    
   ' MsgBox strAddressLbl
    '/////////////////////////////////////////////
    'FOR CIC USE
    'switches the print direction - otherwise, shipping labels will print upside down
    If g_strReturnLbl <> "Y" Then
        strAddressLbl = strAddressLbl & "ZA" & vbCrLf
    End If
    
    g_strReturnLbl = "N"
    
   ' MsgBox strAddressLbl
    '//////////////////////////////////////////////
    strAddressLbl = strAddressLbl & "FE" & vbCrLf   'end form
    
    '------------------------------
    'Print directly to printer port
    '------------------------------
    Open "LPT1" For Output As #1
        Print #1, strAddressLbl
    Close #1
    g_intTotMPSWgt = "0"
    g_intMPSWgt = "0"
    g_BeginReturn = "Y"
    Exit Sub
     
CreateTotalLabelEH:
        MsgBox Err.Description, vbSystemModal, "modCreateTotalLabel"
End Sub
'---------------------------------------------------------------------------------------

'---------------------------------------------------------------------------------------
' Module    : CreateCustomLabel
' DateTime  : 7/12/2004
' Author    : Chris Elwell
' Purpose   : Called if Print Custom Labels is check in Setup Peripherals tab.
'---------------------------------------------------------------------------------------
'

'--------------------------------------------------
'Date: 17 Aug 2005
'Author: Domonic Grande emp396671 FedEx SPEED TEAM
'Purpose: Customize label (see in line comments)
'--------------------------------------------------

Public Sub CreateCustomLabel(Optional ByVal Index As Integer, Optional ByVal strGroundBarcode As String)
    
    If g_str1274 = "111" Then
        Call PrintLTLLabels
    Else
        Call AddTextToLabel
    End If

End Sub

Public Function AddTextToLabel()
    
    On Error GoTo EH
    g_strErrorLocation = "modCustomLabels:GetFirstLabel"
    
    '----------------------------------------------------
    'Holds the label buffer in a var and sends to printer
    '----------------------------------------------------
    Dim strFirstLabel As String
    '-----------------------------------
    'Line being read in from origin file
    '-----------------------------------
    Dim strLine As String
    '---------------------------------
    'Gets file name of label on server
    '---------------------------------
    Dim strFilename As String
    '--------------------------------------------
    'Path and file name on server of label buffer
    'to be passed for deleting file
    '--------------------------------------------
    Dim strPathAndFile As String
    
    '-----------------------
    'Holds label in a string
    '-----------------------
    strFirstLabel = ""
    
   '--------------------------------------
   'determine if there is a label to print
   '--------------------------------------
   strFilename = Dir$(g_strMappedPath & "*." & g_str187)
    

    '---------------------------------
    'Loop until all labels are printed
    '---------------------------------
    Do Until strFilename = ""
        '------------------------------
        'clear var holding label buffer
        '------------------------------
        strFirstLabel = ""
        
        '-------------------------------------------
        'Open file holding label and loop through it
        '-------------------------------------------
        Open g_strMappedPath & strFilename For Input As #8
        
            Do
                Line Input #8, strLine
                '-------------------------------------
                'Loop at service to determine behavior
                '-------------------------------------
                If g_BeginReturn = "Y" Then
                      g_str1274 = g_str1274Return
                End If
                
                Select Case g_str1274
             
                    '-------------------------------------
                    'If ground, make ref field font larger
                    '-------------------------------------
                    Case "90", "92", ""
                        If InStr(strLine, "A10,358,0,1,1,1,N") <> 0 Then
                            strLine = "A10,358,0,4,1,1,N," & Mid(strLine, 19, Len(Trim(strLine)) - 19) & Chr(34)
                        End If
                        If InStr(strLine, "A406,368,0,1,1,1,N") <> 0 Then
                            strLine = "A406,348,0,4,1,1,N" & Mid(strLine, 19, Len(Trim(strLine)) - 19) & Chr(34)
                            strFirstLabel = strFirstLabel & strLine & vbCrLf
                        Else
                            strFirstLabel = strFirstLabel & strLine & vbCrLf
                        End If
                    '-------------------------------------
                    'If express, make ref field font larger
                    '-------------------------------------
                    Case Else
                        If InStr(strLine, "REF:") <> 0 Or InStr(strLine, "Ref:") <> 0 Then
                            strLine = "A10,348,0,4,1,1,N," & Mid(strLine, 19, Len(Trim(strLine)) - 19) & Chr(34)
                            strFirstLabel = strFirstLabel & strLine & vbCrLf
                        Else
                            strFirstLabel = strFirstLabel & strLine & vbCrLf
                        End If
                        
                End Select
                
          
                If strLine = "ZT" Or strLine = "ZA" Then
                    strFirstLabel = strFirstLabel & "ZB" & vbCrLf
                End If
                
'                If strLine = "ZT" Or strLine = "ZA" Or strLine = "ZB" Then
'                With frmSetup
'                    If .f1370(3) Then
'                        strLine = "ZB"
'                    ElseIf .f1370(4) Then
'                        strLine = "ZT"
'                    End If
'                End With
'                End If
                    
                        
            Loop Until EOF(8)
        Close #8
        '----------------------
        'send label to com port
        '----------------------
        Open "LPT1" For Output As #9
            
            
            Print #9, strFirstLabel
        Close #9
        If g_BeginReturn = "Y" Then
            g_BeginReturn = ""
        End If
        
        '------------------------------------
        'Delete txt file on server (label)
        'Note: you can't use a "kill" command
        'across a network
        '------------------------------------
        If Dir$(g_strMappedPath & strFilename) <> "" Then
            strPathAndFile = g_strMappedPath & strFilename
            FileCopy strPathAndFile, g_strLabelPath & strFilename
            Call DeleteFiles(strPathAndFile)
        End If
      
      '----------------------
      'Get name of next label
      '----------------------
       strFilename = Dir$(g_strMappedPath & "*." & g_str187)
 Loop

Release:
    
    Exit Function

EH:
    MsgBox Err.Description, vbCritical, g_strErrorLocation
    Resume Release

End Function

Private Sub DeleteFiles(Optional ByVal strPathAndFile As String)

    On Error GoTo EH
    g_strErrorLocation = "modCustomLabels:DeleteFiles"
    
    Dim FSO As New FileSystemObject
    
    FSO.DeleteFile strPathAndFile, True
    

Release:
    Set FSO = Nothing
    
    Exit Sub

EH:
    MsgBox Err.Description, vbCritical, g_strErrorLocation
    Resume Release

End Sub

Public Sub ReprintCustomLabel(ByVal str29 As String)
'    MsgBox "Add code to re-print Custom Label in modCustomLabels:ReprintCustomLabel"

    On Error GoTo EH
    g_strErrorLocation = "modCustomLabels.ReprintCustomLabel"
    
 
    Dim FSO As New FileSystemObject
    Dim strFileSpec As String
    Dim strDate As String
    
    strDate = Now()
    strDate = Format(strDate, "MMDDYY")
    strFileSpec = g_strLabelPath & strDate & str29 & "." & g_str187
    
   
    MsgBox strFileSpec
    If FSO.FileExists(strFileSpec) Then
        'Copy text file to printer UNC
        FSO.CopyFile strFileSpec, g_strUNCCustomLabels, True
    Else
        MsgBox "File " & strFile & " not found!" & vbCrLf, vbExclamation, "Re-print Error"
    End If
    
Release:
    Set FSO = Nothing
 
    Exit Sub
EH:
    MsgBox Err.Description, vbCritical, g_strErrorLocation
    Resume Release
 
End Sub

'---------------------------------------------------------------------------------------
' Module    : PrintLTLLabels
' DateTime  : 5/8/2007
' Author    : Chris Elwell
' Purpose   : Prints LTL label for each piece and pallet in a shipment.
'---------------------------------------------------------------------------------------
'
Private Sub PrintLTLLabels()
    
    On Error GoTo EH
    g_strErrorLocation = "modCustomLabels:PrintLabel"
    
    Dim FSO As New FileSystemObject
    Dim strFilename As String
    Dim i As Integer
    Dim intTotalLabels As Integer
    
    strFilename = Dir$(g_strMappedPath & "*." & g_str187)
        
    If strFilename = "" Then
        MsgBox "No labels to print.", vbExclamation, "Label Printing"
        GoTo Release
    End If
    
    Do While strFilename <> ""
        
        'Get number of pieces from LTL Item table
        intTotalLabels = GetNumLabels
        
        'Print a label for each piece
        For i = 1 To intTotalLabels
            FSO.CopyFile g_strMappedPath & strFilename, g_strUNCCustomLabels
        Next
        
        'Delete files on server
        Call DeleteFiles(g_strMappedPath & strFilename)
        
        strFilename = Dir()
    Loop
    
    
Release:
    Set FSO = Nothing

    Exit Sub

EH:
    MsgBox Err.Description, vbCritical, g_strErrorLocation
    Resume Release

End Sub
'---------------------------------------------------------------------------------------
' Module    : GetNumLabels
' DateTime  : 4/12/2007
' Author    : Chris Elwell
' Purpose   : Returns the number of pieces + # of pallets for all line items in the
'             current LTL shipment.
'---------------------------------------------------------------------------------------
'
Private Function GetNumLabels() As Integer
    
    On Error GoTo EH
    g_strErrorLocation = "modCustomLabels:GetNumLabels"
    
    Dim rsLTL As New ADODB.Recordset
    Dim strQuery As String
    Dim intNumPieces As Integer
    
    strQuery = "SELECT f2931, f1271 FROM LTLMulti WHERE f1 = '" & g_str1 & "'"
    
    rsLTL.Open strQuery, g_connFSMSClient, adOpenDynamic, adLockOptimistic
    
    intNumPieces = 0
    
    'Add the # of Pieces + # of Pallets for each line item
    Do Until rsLTL.EOF
        intNumPieces = intNumPieces + Val(rsLTL!f2931) + Val(rsLTL!f1271)
        
        rsLTL.MoveNext
    Loop

    'If # of pieces is 0 return 1
    GetNumLabels = IIf(intNumPieces = 0, 1, intNumPieces)
    
Release:
    If rsLTL.State = adStateOpen Then rsLTL.Close
    Set rsLTL = Nothing
    
    Exit Function

EH:
    MsgBox Err.Description, vbCritical, g_strErrorLocation
    Resume Release
    
End Function

#End If

